#lang racket


(require "../base/main.rkt")

(require "domain.rkt"
         "segment.rkt"
         "parametric.rkt"
         "patch.rkt")

(provide cut
         coords)


(define (segmentate-domains curve domains)
  (map (cλ make-segment curve) domains))

(define (patch-domains surface domains)
  (map (cλ make-patch surface) domains))

(define (cut parametric n-domains (cut-fn #f))
  (let ((domain (parametric-domain parametric)))
    (match domain
      ((t-domain _)
       (let* ((cut-fn (or cut-fn (cut-fn-linear)))
              (domains (cut-domain domain n-domains cut-fn)))
         (segmentate-domains parametric domains)))
      ((uv-domain _ _)
       (let* ((cut-fn (or cut-fn (list (cut-fn-linear) (cut-fn-linear))))
              (domains (cut-domain domain n-domains cut-fn)))
         (patch-domains parametric domains))))))

(define (coords parametric n-coords (space-fn parametric-object) (coords-fn #f))
  (let ((domain (parametric-domain parametric))
        (space-fn (space-fn parametric)))
    (match domain
      ((t-domain _)
       (let ((coords-fn (or coords-fn (coords-fn-min))))
         (coords-domain domain n-coords space-fn coords-fn)))
      ((uv-domain _ _)
       (let ((coords-fn (or coords-fn (list (coords-fn-min) (coords-fn-min)))))
         (coords-domain domain n-coords space-fn coords-fn))))))